home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / TPBMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  12KB  |  532 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  6-27-88 11:39 am 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit TPBMain;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, TPDOS, Globals, Overmgr, Core1, MsgBuild,
  19.   Core2, Utilmnu2, Utilmnu1, MsgEntr, NetEntr,
  20.   EditUsr1, EditUsr2, MsgRead, MsgMisc, NetRead,
  21.   FileMnu1, FileMnu2, Download, Upload, Sysop1,
  22.   Sysop3, Sysop2, TypeFile, Initial1, Initial2,
  23.   Sysop4, Loginout, Misc;
  24.   
  25.   
  26. procedure Make_Prompt;
  27.  
  28. procedure set_initial_areas;
  29.  
  30. procedure process_messages;
  31.  
  32. procedure process_files;
  33.  
  34. procedure process_utility;
  35.  
  36. procedure process_sysop;
  37.  
  38.  
  39.   {==========================================================================}
  40.   
  41.   
  42. Implementation
  43.  
  44.  
  45.   procedure Make_Prompt;
  46.   
  47.   var
  48.     temp            : Str14;
  49.     
  50.   begin
  51.     st := hi+white+intstr(time_left, 1)+'-'+yellow+pr_msg[mode]+white;
  52.     case mode of
  53.       message_mode :
  54.         begin
  55.           if AreaReq[1] = '-' then
  56.             begin
  57.               temp := AreaReq;
  58.               Delete(temp, 1, 1);
  59.               st := st+' Echo '+temp
  60.             end
  61.           else
  62.             st := st+' '+AreaReq;
  63.         end;
  64.       files_mode :
  65.         begin
  66.           st := st+' '+SectReq;
  67.           if in_library then
  68.             st := st+' ['+LibReq+']';
  69.           if in_arc then
  70.             st := st+' ['+ArcReq+']';
  71.           if new_dir then
  72.             if disp_dir then
  73.               directory(True)
  74.             else
  75.               directory(False);
  76.           if up_down_display then
  77.             begin
  78.               WriteLn(Com, white);
  79.               WriteLn(Com, user_rec.upload, ' uploads, ', user_rec.download,
  80.                 ' downloads to date.');
  81.               up_down_display := False;
  82.             end;
  83.         end;
  84.     end;
  85.     if (user_rec.access >= 250) and audit_on then
  86.       st := st+' (Audit ON) ';
  87.     st := st+cyan;
  88.   end;
  89.   
  90.   
  91.   
  92.   procedure set_initial_areas;
  93.   
  94.   begin
  95.     if not macro_in_progress then
  96.       begin
  97.         pause;
  98.         list('B');
  99.         pause;
  100.         repeat
  101.         until (not brk) or (not Online);
  102.         WriteLn(Com);
  103.         WriteLn(Com);
  104.         UserWantsScan := ask('Check ALL message areas for mail', 'Y');
  105.         WriteLn(Com);
  106.       end;
  107.     if user_rec.access >= 250 then
  108.       begin
  109.         mesg_area_change('SYSTEM');
  110.         file_area_change('NEWIN');
  111.       end
  112.     else
  113.       begin
  114.         mesg_area_change('POST');
  115.         file_area_change('LOGIN')
  116.       end;
  117.   end;
  118.   
  119.   
  120.   
  121.   procedure process_messages;
  122.   
  123.   begin
  124.     fido := ((AreaReq = 'NETMAIL') or (AreaReq[1] = '-'));
  125.     case ch of
  126.       'A' :
  127.         Articles;
  128.       'C' :
  129.         mesg_area_change('');
  130.       'E' :
  131.         if fido then
  132.           fido_mesg_enter(' ', dummy_str, dummy_subj, ' ', dummy_int)
  133.         else
  134.           begin
  135.             mesg_enter(' ');
  136.             mesg_build_index(AreaSet)
  137.           end;
  138.       'F' :
  139.         mode := files_mode;
  140.       'G' :
  141.         in_use := False;
  142.       'Q' :
  143.         if fido then
  144.           fido_mesg_read('Q')
  145.         else
  146.           mesg_quick_scan;
  147.       'R' :
  148.         if fido then
  149.           fido_mesg_read(' ')
  150.         else
  151.           mesg_read;
  152.       'S' :
  153.         if fido then
  154.           fido_mesg_read('S')
  155.         else
  156.           mesg_summary;
  157.       'U' :
  158.         mode := utility_mode;
  159.       'X' :
  160.         if (user_rec.access >= 250) or (not remote_copy) then
  161.           begin
  162.             if Length(menu_password) > 1 then
  163.               begin
  164.                 menu_temp := prompt('Enter Password', 8, 'SN');
  165.                 if menu_temp = menu_password then
  166.                   mode := sysop_mode;
  167.               end
  168.             else
  169.               mode := sysop_mode;
  170.           end;
  171.       'B', 'I', 'W' :
  172.         list(ch);
  173.       'O' :
  174.         list_file('OTHERSYS.LST', HomName);
  175.       '?', '/' :
  176.         begin
  177.           list('M');
  178.           if (not macro_in_progress) then
  179.             begin
  180.               mult_cmds := False;
  181.               Cmd_Queue := '';
  182.               Clear_inbuf;
  183.             end;
  184.         end
  185.     else
  186.       begin
  187.         if (not macro_in_progress) then
  188.           begin
  189.             mult_cmds := False;
  190.             Cmd_Queue := '';
  191.             Clear_inbuf;
  192.           end;
  193.       end;
  194.     end;
  195.   end;
  196.   
  197.   
  198.   
  199.   procedure process_files;
  200.   
  201.   begin
  202.     if (st[1] = 'S') and
  203.     ((test_bit(user_rec.flags, 1)) and (SectReq <> 'LOGIN')) then
  204.       list('S')
  205.     else if st = 'REN' then
  206.       rename_file
  207.     else if st = 'DEL' then
  208.       delete_file
  209.     else if st = 'COPY' then
  210.       copy_file
  211.     else if st = 'STAT' then
  212.       file_status
  213.     else if st = 'DIR' then
  214.       directory(True)
  215.     else if st = 'SG' then
  216.       SendXmodem('G')
  217.     else if st = 'SB' then
  218.       SendXmodem('B')
  219.     else if st = 'SY' then
  220.       SendXmodem('Y')
  221.     else if st = 'SX' then
  222.       SendXmodem('X')
  223.     else if st = 'SC' then
  224.       SendXmodem('C')
  225.     else if st = 'SO' then
  226.       SendXmodem('O')
  227.     else if st = 'SZ' then
  228.       SendXmodem('Z')
  229.     else if st = 'SQ' then
  230.       SendXmodem('Q')
  231.     else if st = 'RZ' then
  232.       begin
  233.         if in_library or in_arc then
  234.           ArcLbr;
  235.         RecvXmodem('Z');
  236.       end
  237.     else if st = 'RG' then
  238.       begin
  239.         if in_library or in_arc then
  240.           ArcLbr;
  241.         RecvXmodem('G');
  242.       end
  243.     else if st = 'RQ' then
  244.       begin
  245.         if in_library or in_arc then
  246.           ArcLbr;
  247.         RecvXmodem('Q');
  248.       end
  249.     else if st = 'RB' then
  250.       begin
  251.         if in_library or in_arc then
  252.           ArcLbr;
  253.         RecvXmodem('B');
  254.       end
  255.     else if st = 'RO' then
  256.       begin
  257.         if in_library or in_arc then
  258.           ArcLbr;
  259.         RecvXmodem('O');
  260.       end
  261.     else if st = 'RY' then
  262.       begin
  263.         if in_library or in_arc then
  264.           ArcLbr;
  265.         RecvXmodem('Y');
  266.       end
  267.     else if st = 'RX' then
  268.       begin
  269.         if in_library or in_arc then
  270.           ArcLbr;
  271.         RecvXmodem('X');
  272.       end
  273.     else if st = 'RC' then
  274.       begin
  275.         if in_library or in_arc then
  276.           ArcLbr;
  277.         RecvXmodem('C');
  278.       end
  279.     else if st = 'FIND' then
  280.       begin
  281.         if in_library or in_arc then
  282.           ArcLbr;
  283.         newin_list('F');
  284.       end
  285.     else if st = 'TYPE' then
  286.       SendText
  287.     else
  288.       case ch of
  289.         'A' :
  290.           ArcLbr;
  291.         'C' :
  292.           begin
  293.             if in_arc or in_library then
  294.               ArcLbr;
  295.             file_area_change('')
  296.           end;
  297.         'D' :
  298.           directory(True);
  299.         'F' :
  300.           files_list;
  301.         'G' :
  302.           in_use := False;
  303.         'L' :
  304.           begin
  305.             if in_library or in_arc then
  306.               ArcLbr;
  307.             newin_list('F');
  308.           end;
  309.         'M' :
  310.           mode := message_mode;
  311.         'N' :
  312.           begin
  313.             if in_library or in_arc then
  314.               ArcLbr;
  315.             newin_list('N');
  316.           end;
  317.         'R' :
  318.           begin
  319.             ch := user_rec.protocol;
  320.             if in_library or in_arc then
  321.               ArcLbr;
  322.             RecvXmodem(ch);
  323.           end;
  324.         'S' :
  325.           begin
  326.             ch := user_rec.protocol;
  327.             SendXmodem(ch)
  328.           end;
  329.         'T' :
  330.           SendText;
  331.         'U' :
  332.           mode := utility_mode;
  333.         'X' :
  334.           if (user_rec.access >= 250) or (not remote_copy) then
  335.             begin
  336.               if Length(menu_password) > 1 then
  337.                 begin
  338.                   menu_temp := prompt('Enter Password', 8, 'SN');
  339.                   if menu_temp = menu_password then
  340.                     mode := sysop_mode;
  341.                 end
  342.               else
  343.                 mode := sysop_mode;
  344.             end;
  345.         'Z' :
  346.           toggle_st_switch;
  347.         '?', '/' :
  348.           begin
  349.             list('F');
  350.             if user_rec.access >= 250 then
  351.               list('Z');
  352.             if (not macro_in_progress) then
  353.               begin
  354.                 mult_cmds := False;
  355.                 Cmd_Queue := '';
  356.                 Clear_inbuf;
  357.               end;
  358.           end
  359.       else
  360.         begin
  361.           if (not macro_in_progress) then
  362.             begin
  363.               mult_cmds := False;
  364.               Cmd_Queue := '';
  365.               Clear_inbuf;
  366.             end;
  367.         end;
  368.       end;
  369.   end;
  370.   
  371.   
  372.   
  373.   procedure process_utility;
  374.   
  375.   begin
  376.     case ch of
  377.       'A' :
  378.         alter_user_params;
  379.       'C' :
  380.         if chat then
  381.           mesg_enter('S');
  382.       'F' :
  383.         mode := files_mode;
  384.       'G' :
  385.         in_use := False;
  386.       'M' :
  387.         mode := message_mode;
  388.       'P' :
  389.         get_protocol;
  390.       'S' :
  391.         display_stats;
  392.       'T' :
  393.         display_time;
  394.       'U' :
  395.         display_users;
  396.       'Y' :
  397.         show_user_stats;
  398.       'X' :
  399.         if (user_rec.access >= 250) or (not remote_copy) then
  400.           begin
  401.             if Length(menu_password) > 1 then
  402.               begin
  403.                 menu_temp := prompt('Enter Password', 8, 'SN');
  404.                 if menu_temp = menu_password then
  405.                   mode := sysop_mode;
  406.               end
  407.             else
  408.               mode := sysop_mode;
  409.           end;
  410.       'Z' :
  411.         begin
  412.           if graphics then
  413.             graphics_off
  414.           else
  415.             graphics_on
  416.         end;
  417.       '?', '/' :
  418.         begin
  419.           list('U');
  420.           if (not macro_in_progress) then
  421.             begin
  422.               mult_cmds := False;
  423.               Cmd_Queue := '';
  424.               Clear_inbuf;
  425.             end;
  426.         end
  427.     else
  428.       begin
  429.         if (not macro_in_progress) then
  430.           begin
  431.             mult_cmds := False;
  432.             Cmd_Queue := '';
  433.             Clear_inbuf;
  434.           end;
  435.       end;
  436.     end;
  437.   end;
  438.   
  439.   
  440.   
  441.   procedure process_sysop;
  442.   
  443.   var
  444.     not_saved       : Boolean;
  445.     
  446.   begin
  447.     case ch of
  448.       'A' :
  449.         toggle_audit;
  450.       'B' :
  451.         make_message('', '', '', '');
  452.       'D' :
  453.         delete_user;
  454.       'E' :
  455.         edit_user('', '', 0);
  456.       'F' :
  457.         mode := files_mode;
  458.       'G' :
  459.         in_use := False;
  460.       'I' :
  461.         rebuild_index;
  462.       'L' :
  463.         print_log;
  464.       'M' :
  465.         mode := message_mode;
  466.       'N' :
  467.         process_newin;
  468.       'O' :
  469.         process_macro;
  470.       'P' :
  471.         purge_files;
  472.       'Q' :
  473.         in_use := False;
  474.       'R' :
  475.         print_messages;
  476.       'S' :
  477.         sys_dir;
  478.       'T' :
  479.         toggle_printer;
  480.       'U' :
  481.         mode := utility_mode;
  482.       'V' :
  483.         validate_user('', '');
  484.       'X' :
  485.         begin
  486.           if local_online or (not remote_copy) then
  487.             begin
  488.               ClrScr;
  489.               errcode := ExecDos(CommandPath, False, nil);
  490.               new_dir := True;
  491.             end
  492.           else
  493.             begin
  494.               ScrollOn;
  495.               errcode := ExecDos(CommandPath+' /C REMOTE', False, nil);
  496.               ScrollOff;
  497.               Ch_Init;
  498.               Ch_Set(rate);
  499.             end;
  500.           SetSect(HomName);
  501.         end;
  502.       'Y' :
  503.         move_from_newin;
  504.       'Z' :
  505.         if local_online then
  506.           full_screen_edit('', ' ', not_saved);
  507.       '?', '/' :
  508.         begin
  509.           list('X');
  510.           if (not macro_in_progress) then
  511.             begin
  512.               mult_cmds := False;
  513.               Cmd_Queue := '';
  514.               Clear_inbuf;
  515.             end;
  516.         end;
  517.     else
  518.       begin
  519.         if (not macro_in_progress) then
  520.           begin
  521.             mult_cmds := False;
  522.             Cmd_Queue := '';
  523.             Clear_inbuf;
  524.           end;
  525.       end;
  526.     end;
  527.   end;
  528.   
  529.   
  530. end.                              { of TPBMAIN.PAS }
  531. 
  532.